home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / runtime / freelist.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-24  |  3.1 KB  |  133 lines  |  [TEXT/MPS ]
  1. #include "config.h"
  2. #include "debugger.h"
  3. #include "freelist.h"
  4. #include "gc.h"
  5. #include "major_gc.h"
  6. #include "misc.h"
  7. #include "mlvalues.h"
  8.  
  9. typedef struct {
  10.   char *next_block_bp;
  11. } block;
  12.  
  13. #ifdef DEBUG
  14. void fl_verify (fl)
  15.      free_list_t fl;
  16. {
  17.   char *cur;
  18.   char **prev;
  19.  
  20.   prev = &(fl->first_block_bp);
  21.   cur = *prev;
  22.   while (cur != NULL){
  23.     Assert (Is_in_heap (cur));
  24.     prev = &(((block *) cur)->next_block_bp);
  25.     cur = *prev;
  26.   }
  27. }
  28. #endif
  29.  
  30. free_list_t fl_new ()
  31. {
  32.   free_list_t result = (free_list_t) malloc (sizeof (struct free_list));
  33.  
  34.   result->first_block_bp = NULL;
  35.   result->total_wosize = 0;
  36.   return result;
  37. }
  38.  
  39. void fl_free (fl)
  40.      free_list_t fl;
  41. {
  42.   free ((char *) fl);
  43. }
  44.  
  45. char *fl_allocate (fl, sz)
  46.      free_list_t fl;
  47.      mlsize_t sz;
  48. {
  49.   char *cur;
  50.   char **prev;
  51.   char *new_hp;
  52.  
  53.   Assert (sizeof (char *) == sizeof (value));
  54.   prev = &(fl->first_block_bp);
  55.   cur = *prev;
  56.   while (cur != NULL){
  57.     Assert (Is_in_heap (cur));
  58.     if (Wosize_op (cur) >= sz){
  59.       if (Wosize_op (cur) >= Whsize_wosize (sz) + 1){
  60.     /* Allocate a chunk from the end of the block. */
  61.     new_hp = cur + Bosize_op (cur) - Bhsize_wosize (sz);
  62.     /* Blue tells the GC not to collect this block. */
  63.     Hd_hp (new_hp) = Make_header (sz, 0, Blue);
  64.     Hd_op (cur) = Make_header(Wosize_op(cur) - Whsize_wosize(sz), 0, Blue);
  65.     fl->total_wosize -= Whsize_wosize (sz);
  66.     return new_hp;
  67.       }else{
  68.     /* Detach the block from the free-list. */
  69.     *prev = ((block *) cur)->next_block_bp;
  70.     Assert (Is_in_heap (*prev) || *prev == NULL);
  71.     if (Wosize_op (cur) == Whsize_wosize (sz)){
  72.       /* Leave an extra empty block.  We leave it at the end of the
  73.              useful block so that the sweeping code will collapse them when the
  74.              useful block is deallocated. */
  75.       Hd_hp (cur + Bsize_wsize (sz)) = Make_header (0, 0, White);
  76.       Hd_op (cur) = Make_header (sz, 0, Blue);
  77.       fl->total_wosize -= Whsize_wosize (sz);
  78.       return Hp_op (cur);
  79.     }else{
  80.       Assert (Wosize_op (cur) == sz);
  81.       /* Allocate the whole block. */
  82.       fl->total_wosize -= sz;
  83.       return Hp_op (cur);
  84.     }
  85.       }
  86.     }
  87.     prev = &(((block *) cur)->next_block_bp);
  88.     cur = *prev;
  89.   }
  90.   /* No suitable block was found. */
  91.   return NULL;
  92. }
  93.  
  94. void fl_add_block (fl, bp)
  95.      free_list_t fl;
  96.      char *bp;
  97. {
  98.   mlsize_t sz;
  99.   mlsize_t prevsz;
  100.  
  101.   Assert (sizeof (char *) == sizeof (value));
  102.   sz = Wosize_bp (bp);
  103. #ifdef DEBUG
  104.   { mlsize_t i;
  105.     for (i = 0; i < sz; i++) Field (Val_bp (bp), i) = not_random ();
  106.   }
  107. #endif
  108.   if (fl->first_block_bp != NULL){
  109.     prevsz = Wosize_bp (fl->first_block_bp);
  110.   }else{
  111.     prevsz = 0;
  112.   }
  113.   if ((fl->first_block_bp + Bsize_wsize (prevsz)) == Hp_bp (bp)){
  114.     /* Collapse the new block with the first block of the free-list. */
  115.     sz = Whsize_wosize (sz);
  116. #ifdef DEBUG
  117.     Hd_bp (bp) = not_random ();
  118. #endif
  119.     Hd_bp (fl->first_block_bp) = Make_header (prevsz + sz, 0, Blue);
  120.     fl->total_wosize += sz;
  121.   }else{
  122.     if (sz >= 1){
  123.       Hd_bp (bp) = Make_header (sz, 0, Blue);
  124.       ((block *) bp)->next_block_bp = fl->first_block_bp;
  125.       fl->first_block_bp = bp;
  126.       fl->total_wosize += sz;
  127.     }else{
  128.       Assert (sz == 0);
  129.       Hd_bp (bp) = Make_header (0, 0, White);
  130.     }
  131.   }
  132. }
  133.